C--------------------------------------------------------------------------- 

C Program name: TopDraw test program.

C Author: Gareth Williams

C Description:

C Modification history : (Version), (Date), (Name), (Description).

C 1.0, 1st June 1991, G. Williams, First Version.

C 2.0, June 1992, G. Williams, Converted to SunPHIGS 2.0.

C----------------------------------------------------------------------------

       PROGRAM toptest

       include './sunphigs77.h'
       include './sunptk77.h'

C--------------------------------------------------------------------------

       INTEGER err, minid, maxid
       INTEGER white, black, green, grey
       LOGICAL ptkf_readphinterscript
       INTEGER ptkf_stringtoint
       LOGICAL docolour

       implicit undefined (P, p, E, e)

C colour or monochrome
       docolour = .TRUE.
              
       print *,('Demonstrating the topdraw module of the 
& PHIGS Toolkit...')
       print *,('Opening SunPHIGS...')

       call popph(6, 0)

C     create the workstation type (either tool or canvas) 
              
C     open the workstation 

       if (ptkf_readphinterscript('../../scripts/openws.scr', 0, 0) .eq.
& .FALSE.) then     
         goto 30
       endif
       
       call psdus(1, PWAITD, PNIVE)

       minid = 0
       maxid = 30
       call ptkf_inithashtables()
       call ptkf_createhashtable('structureid', 17, 100)
       call ptkf_createhashtable('label', minid, maxid)
       call ptkf_createhashtable('name', minid, maxid)
       call ptkf_createhashtable('colourindex', 1, 8)

       
C     make dummy network 
     
       if (ptkf_readphinterscript('../../scripts/lamp.scr', 
& 0, 0)) then
         call ptkf_createtopology(1, 
& ptkf_stringtoint('structureid', 'lamp'), err)

       if (docolour .eq. .TRUE.) then
         call ptkf_setcolourrep(1, 'black')
         call ptkf_setcolourrep(1, 'white')
         call ptkf_setcolourrep(1, 'grey')
         call ptkf_setcolourrep(1, 'green')
         call ptkf_setcolourrep(1, 'red')
         call ptkf_setcolourrep(1, 'blue')
         green = ptkf_stringtoint('colourindex', 'green')
         grey = ptkf_stringtoint('colourindex', 'grey')
         white = ptkf_stringtoint('colourindex', 'white')
         black = ptkf_stringtoint('colourindex', 'black')
         call ptkf_setbackgroundcolourind(1, grey)
         call ptkf_settopologyattrs(1, PFONTTRIPLEX, white,
& black, white, green, white, green)
       endif

         call ptkf_posttopology(1, 1, 0.0)
         call prst(1, PALWAY)
         call options()
       endif

 30    call pclwk(1)
       call pclph()

       STOP
       END

C--------------------------------------------------------------------------

       SUBROUTINE options()
       CHARACTER*20 commandstr
       INTEGER lencom
       LOGICAL topquit
       REAL echoarea(4)
       INTEGER lldr, pldr
       CHARACTER*80 ldatrec(1), pdatrec(1)
       CHARACTER*80 storename
       INTEGER*4 fileptr, err
       INTEGER ptkf_fopen
       INTEGER ptkf_fclose

       include './sunptk77.h'

       storename = '../../data/store.dat'
       topquit = .FALSE.
       call ptkf_limit(0.0, 0.25, 0.0, 0.01, echoarea)
 10    call ptkf_readstring(1, 'boxtopology', 
& 'Input command (default = boxtopology) >', echoarea, 20, 
& commandstr, lencom)
       if (commandstr(1:lencom) .eq. 'boxtopology') then
         call ptkf_settopologytype(1, PTKEBOXTOPOLOGY)

      else if (commandstr(1:lencom) .eq. 'structnettopology') then
         call ptkf_settopologytype(1, PTKESTRUCTNETTOPOLOGY)

      else if (commandstr(1:lencom) .eq. 'structtopology') then
         call ptkf_settopologytype(1, PTKESTRUCTTOPOLOGY)

      else if (commandstr(1:lencom) .eq. 'tidysingle') then
         ldr = 0
         pdr = 0
         call ptkf_tidytopology(1, 1, PTKESINGLE, 1, 1, pldr, pdatrec,
& 1, 1, lldr, ldatrec)

      else if (commandstr(1:lencom) .eq. 'tidygroup') then
         ldr = 0
         pdr = 0
         call ptkf_tidytopology(1, 1,PTKEGROUP, 1, 1, pldr, pdatrec,
& 1, 1, lldr, ldatrec)

      else if (commandstr(1:lencom) .eq. 'store') then
         fileptr = ptkf_fopen(storename, 'w+')
         print *,'storing layout in', storename
         print *,('Testing ptkf_storetopologylayout()...')
         call ptkf_storetopologylayout(fileptr, 1)
         err = ptkf_fclose(fileptr)

      else if (commandstr(1:lencom) .eq. 'restore') then
         fileptr = ptkf_fopen(storename, 'r')
         print *,'restoring layout from', storename
         print *,('Testing ptkf_restoretopologylayout()...')
         call ptkf_restoretopologylayout(fileptr, 1) 
         err = ptkf_fclose(fileptr)

      else if (commandstr(1:lencom) .eq. 'quit') then
         topquit = .TRUE.

      else
         print *,('Command unknown')    
      endif

       call prst(1, PALWAY)

       if (topquit .eq. .TRUE.) then
         goto 20
       else 
         goto 10
       endif

 20    RETURN
       END
                 
C--------------------------------------------------------------------------
         
C     end of toptest.f
